Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue48/Alfresco/AACRC.pas

Pascal/Delphi Source File | 1999-06-20 | 15.9 KB | 579 lines

{*********************************************************}
{* AACRC                                                 *}
{* Copyright (c) Julian M Bucknall 1998-1999             *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Algorithms Alfresco CRC unit                          *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AACRC;

{$I AADefine.INC}

interface

uses
  SysUtils;

const
  {magic polynomials for standard CRC implementations}
  {..16-bit}
  PolyCRCCCITT = $1021;
  PolyXMODEMCRC = $1021;
  PolyCRC16 = $8005;
  {..32-bit}
  PolyCRC32 = $04C11DB7;
  PolyAAL5 = $04C11DB7;

type
  TaaCRC16 = word;
  {$IFDEF Delphi4Plus}
  TaaCRC32 = longword;
  {$ELSE}
  TaaCRC32 = longint;
  {$ENDIF}

  Paa16BitCRCTable = ^Taa16BitCRCTable;
  Taa16BitCRCTable = array [0..255] of TaaCRC16;

  Paa32BitCRCTable = ^Taa32BitCRCTable;
  Taa32BitCRCTable = array [0..255] of TaaCRC32;

type
  TaaCRC16Calculator = class
    private
      ccInitValue   : TaaCRC16;
      ccMagicPoly   : TaaCRC16;
      ccNotResult   : boolean;
      ccReverseBits : boolean;
      ccTable       : Paa16BitCRCTable;
    protected
      procedure ccCreateTable;
    public
      constructor Create(aMagicPoly   : TaaCRC16;
                         aReverseBits : boolean;
                         aInitValue   : TaaCRC16;
                         aNotResult   : boolean);
      destructor Destroy; override;

      function GetCRC(var aBuffer; aBufLen : integer) : TaaCRC16;
      function GetCRCStd(var aBuffer; aBufLen : integer) : TaaCRC16;

      function UpdateCRC(aValue : byte; aCRC : TaaCRC16) : TaaCRC16;

      procedure SaveToIncFile(const aIncFileName : string);
  end;

  TaaCRC32Calculator = class
    private
      ccInitValue   : TaaCRC32;
      ccMagicPoly   : TaaCRC32;
      ccNotResult   : boolean;
      ccReverseBits : boolean;
      ccTable       : Paa32BitCRCTable;
    protected
      procedure ccCreateTable;
    public
      constructor Create(aMagicPoly   : TaaCRC32;
                         aReverseBits : boolean;
                         aInitValue   : TaaCRC32;
                         aNotResult   : boolean);
      destructor Destroy; override;

      function GetCRC(var aBuffer; aBufLen : integer) : TaaCRC32;
      function GetCRCStd(var aBuffer; aBufLen : integer) : TaaCRC32;

      function UpdateCRC(aValue : byte; aCRC : TaaCRC32) : TaaCRC32;

      procedure SaveToIncFile(const aIncFileName : string);
  end;

{routines used in article exposition}
function AAGet16BitCRCStd(var aBuffer; aBufLen    : integer;
                              aMagicPoly : TaaCRC16) : TaaCRC16;

procedure AACalc16BitCRCTable(var aTable     : Taa16BitCRCTable;
                                  aMagicPoly : TaaCRC16);

function AAGet16BitCRCTbl(var aBuffer; aBufLen : integer;
                        const aTable  : Taa16BitCRCTable) : TaaCRC16;

implementation

{===Helper routines==================================================}
function IntToHex(aValue : longint; aCount : integer) : string;
  {-return the hex string with aCount digits for aValue}
var
  Digit : integer;
  Mask  : longint;
  i     : integer;
begin
  Result := '';
  Mask := longint($F) shl (pred(aCount) * 4);
  for i := pred(aCount) downto 0 do begin
    Digit := (aValue and Mask) shr (i * 4);
    if (Digit <= 9) then
      Result := Result + char(ord('0') + Digit)
    else
      Result := Result + char(ord('a') + Digit - 10);
    Mask := Mask shr 4;
  end;
end;
{--------}
function ReverseBits(aValue : longint; aBits : integer) : longint;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to pred(aBits) do begin
    if Odd(aValue) then
      Result := (Result shl 1) or 1
    else
      Result := (Result shl 1);
    aValue := aValue shr 1;
  end;
end;
{--------}
procedure WriteHeader(const aIncFileName : string;
                      var F : text);
var
  FileName : string;
begin
  FileName := ExtractFileName(aIncFileName);
  writeln(F, '{*********************************************************}');
  writeln(F, '{* ', FileName, ' ':54-length(FileName), '*}');
  writeln(F, '{* Copyright (c) Julian M Bucknall 1998-1999             *}');
  writeln(F, '{* All rights reserved.                                  *}');
  writeln(F, '{*********************************************************}');
  writeln(F, '{* Algorithms Alfresco auto-generated CRC table          *}');
  writeln(F, '{*********************************************************}');
  writeln(F);
end;

{====================================================================}


{===TaaCRC16Calculator===============================================}
constructor TaaCRC16Calculator.Create(aMagicPoly   : TaaCRC16;
                                      aReverseBits : boolean;
                                      aInitValue   : TaaCRC16;
                                      aNotResult   : boolean);
begin
  inherited Create;
  ccMagicPoly := aMagicPoly;
  ccReverseBits := aReverseBits;
  ccInitValue := aInitValue;
  ccNotResult := aNotResult;
end;
{--------}
destructor TaaCRC16Calculator.Destroy;
begin
  if (ccTable <> nil) then
    Dispose(ccTable);
  inherited Destroy;
end;
{--------}
procedure TaaCRC16Calculator.ccCreateTable;
const
  TopmostBitMask = $8000;
var
  i   : integer;
  Reg : TaaCRC16;
  bit : integer;
begin
  New(ccTable);
  for i := 0 to 255 do begin
    if ccReverseBits then
      Reg := ReverseBits(i, 16)
    else
      Reg := i shl 8;
    for bit := 0 to 7 do begin
      if ((Reg and TopmostBitMask) <> 0) then
        Reg := (Reg shl 1) xor ccMagicPoly
      else
        Reg := (Reg shl 1);
    end;
    if ccReverseBits then
      ccTable^[i] := ReverseBits(Reg, 16)
    else
      ccTable^[i] := Reg;
  end;
end;
{--------}
function TaaCRC16Calculator.GetCRC(var aBuffer; aBufLen : integer) : TaaCRC16;
var
  i   : integer;
  Reg : TaaCRC32;
  Buf : TByteArray absolute aBuffer;
begin
  {if the CRC table hasn't yet been calculated, allocate it and do so}
  if (ccTable = nil) then
    ccCreateTable;
  {initialise the register}
  Reg := ccInitValue;
  {calculate the CRC}
  if ccReverseBits then
    for i := 0 to pred(aBufLen) do
      Reg := ccTable^[byte(Reg) xor Buf[i]] xor (Reg shr 8)
  else
    for i := 0 to pred(aBufLen) do
      Reg := ccTable^[byte(Reg shr 8) xor Buf[i]] xor (Reg shl 8);
  {if required, not the result}
  if ccNotResult then
    Reg := not Reg;
  {return the register}
  Result := Reg;
end;
{--------}
function TaaCRC16Calculator.GetCRCStd(var aBuffer; aBufLen : integer) : TaaCRC16;
var
  i   : integer;
  Buf : TByteArray absolute aBuffer;
  Reg : TaaCRC16;
  B   : byte;
  bit : integer;
  MagicPoly : TaaCRC16;
begin
  {initialise the register}
  Reg := ccInitValue;

  {split the flow: first the case for feeding in bytes the least
   significant bit first}
  if ccReverseBits then begin
    {reverse the magic polynomial}
    MagicPoly := ReverseBits(ccMagicPoly, 16);
    {do for all bytes in the buffer...}
    for i := 0 to pred(aBufLen) do begin
      B := Buf[i];
      for bit := 0 to 7 do begin
        if ((Reg and 1) xor (B and 1)) <> 0 then
          Reg := (Reg shr 1) xor MagicPoly
        else
          Reg := (Reg shr 1);
        B := B shr 1;
      end;
    end;
  end

  {now the case for feeding in bytes the most significant bit first}
  else begin
    {do for all bytes in the buffer...}
    for i := 0 to pred(aBufLen) do begin
      B := Buf[i];
      for bit := 0 to 7 do begin
        if ((B shr 7) xor ((Reg and $8000) shr 15)) <> 0 then
          Reg := (Reg shl 1) xor ccMagicPoly
        else
          Reg := (Reg shl 1);
        B := B shl 1;
      end;
    end;
  end;

  {if required, not the result}
  if ccNotResult then
    Reg := not Reg;
  {return the register}
  Result := Reg;
end;
{--------}
procedure TaaCRC16Calculator.SaveToIncFile(const aIncFileName : string);
var
  F : text;
  i : integer;
  j : integer;
begin
  {if the CRC table hasn't yet been calculated, allocate it and do so}
  if (ccTable = nil) then
    ccCreateTable;
  {create the file anew}
  System.Assign(F, aIncFileName);
  System.Rewrite(F);
  try
    WriteHeader(aIncFileName, F);
    writeln(F, 'const');
    writeln(F, '  AACRCTable16 : array [0..255] of TaaCRC16 = (');
    j := 0;
    for i := 0 to 255 do begin
      if (j = 0) then
        write(F, '     ');
      write(F, '$', IntToHex(ccTable^[i], 4));
      if i = 255 then
        write(F, ');')
      else
        write(F, ', ');
      inc(j);
      if (j = 8) then begin
        writeln(F);
        j := 0;
      end;
    end;
    writeln(F);
  finally
    System.Close(F);
  end;
end;
{--------}
function TaaCRC16Calculator.UpdateCRC(aValue : byte; aCRC : TaaCRC16) : TaaCRC16;
begin
  if ccReverseBits then
    Result := ccTable^[byte(aCRC) xor aValue] xor (aCRC shr 8)
  else
    Result := ccTable^[byte(aCRC shr 8) xor aValue] xor (aCRC shl 8);
end;
{====================================================================}


{===TaaCRC32Calculator===============================================}
constructor TaaCRC32Calculator.Create(aMagicPoly   : TaaCRC32;
                                      aReverseBits : boolean;
                                      aInitValue   : TaaCRC32;
                                      aNotResult   : boolean);
begin
  inherited Create;
  ccMagicPoly := aMagicPoly;
  ccReverseBits := aReverseBits;
  ccInitValue := aInitValue;
  ccNotResult := aNotResult;
end;
{--------}
destructor TaaCRC32Calculator.Destroy;
begin
  if (ccTable <> nil) then
    Dispose(ccTable);
  inherited Destroy;
end;
{--------}
procedure TaaCRC32Calculator.ccCreateTable;
const
  TopmostBitMask = $80000000;
var
  i   : integer;
  Reg : TaaCRC32;
  bit : integer;
begin
  New(ccTable);
  for i := 0 to 255 do begin
    if ccReverseBits then
      Reg := ReverseBits(i, 32)
    else
      Reg := TaaCRC32(i) shl 24;
    for bit := 0 to 7 do begin
      if ((Reg and TopmostBitMask) <> 0) then
        Reg := (Reg shl 1) xor ccMagicPoly
      else
        Reg := (Reg shl 1);
    end;
    if ccReverseBits then
      ccTable^[i] := ReverseBits(Reg, 32)
    else
      ccTable^[i] := Reg;
  end;
end;
{--------}
function TaaCRC32Calculator.GetCRC(var aBuffer; aBufLen : integer) : TaaCRC32;
var
  i   : integer;
  Reg : TaaCRC32;
  Buf : TByteArray absolute aBuffer;
begin
  {if the CRC table hasn't yet been calculated, allocate it and do so}
  if (ccTable = nil) then
    ccCreateTable;
  {initialise the register}
  Reg := ccInitValue;
  {calculate the CRC}
  if ccReverseBits then
    for i := 0 to pred(aBufLen) do
      Reg := ccTable^[byte(Reg) xor Buf[i]] xor (Reg shr 8)
  else
    for i := 0 to pred(aBufLen) do
      Reg := ccTable^[byte(Reg shr 24) xor Buf[i]] xor (Reg shl 8);
  {if required, not the result}
  if ccNotResult then
    Reg := not Reg;
  {return the register}
  Result := Reg;
end;
{--------}
function TaaCRC32Calculator.GetCRCStd(var aBuffer; aBufLen : integer) : TaaCRC32;
var
  i   : integer;
  Buf : TByteArray absolute aBuffer;
  Reg : TaaCRC32;
  bit : integer;
  B   : byte;
  MagicPoly : TaaCRC32;
begin
  {initialise the register}
  Reg := ccInitValue;

  {split the flow: first the case for feeding in bytes the least
   significant bit first}
  if ccReverseBits then begin
    {reverse the magic polynomial}
    MagicPoly := ReverseBits(ccMagicPoly, 32);
    {do for all bytes in the buffer...}
    for i := 0 to pred(aBufLen) do begin
      B := Buf[i];
      for bit := 0 to 7 do begin
        if ((Reg and 1) xor (B and 1)) <> 0 then
          Reg := (Reg shr 1) xor MagicPoly
        else
          Reg := (Reg shr 1);
        B := B shr 1;
      end;
    end;
  end

  {now the case for feeding in bytes the most significant bit first}
  else begin
    {do for all bytes in the buffer...}
    for i := 0 to pred(aBufLen) do begin
      B := Buf[i];
      for bit := 0 to 7 do begin
        if ((B shr 7) xor (Reg shr 31)) <> 0 then
          Reg := (Reg shl 1) xor ccMagicPoly
        else
          Reg := (Reg shl 1);
        B := B shl 1;
      end;
    end;
  end;

  {if required, not the result}
  if ccNotResult then
    Reg := not Reg;
  {return the register}
  Result := Reg;
end;
{--------}
procedure TaaCRC32Calculator.SaveToIncFile(const aIncFileName : string);
var
  F : text;
  i : integer;
  j : integer;
begin
  {if the CRC table hasn't yet been calculated, allocate it and do so}
  if (ccTable = nil) then
    ccCreateTable;
  {create the file anew}
  System.Assign(F, aIncFileName);
  System.Rewrite(F);
  try
    WriteHeader(aIncFileName, F);
    writeln(F, 'const');
    writeln(F, '  AACRCTable32 : array [0..255] of TaaCRC32 = (');
    j := 0;
    for i := 0 to 255 do begin
      if (j = 0) then
        write(F, '     ');
      write(F, '$', IntToHex(ccTable^[i], 8));
      if i = 255 then
        write(F, ');')
      else
        write(F, ', ');
      inc(j);
      if (j = 6) then begin
        writeln(F);
        j := 0;
      end;
    end;
    writeln(F);
  finally
    System.Close(F);
  end;
end;
{--------}
function TaaCRC32Calculator.UpdateCRC(aValue : byte; aCRC : TaaCRC32) : TaaCRC32;
begin
  if ccReverseBits then
    Result := ccTable^[byte(aCRC) xor aValue] xor (aCRC shr 8)
  else
    Result := ccTable^[byte(aCRC shr 24) xor aValue] xor (aCRC shl 8);
end;
{====================================================================}


{===Standard CRC routines============================================}
function AAGet16BitCRCStd(var aBuffer; aBufLen    : integer;
                              aMagicPoly : TaaCRC16) : TaaCRC16;
const
  TopmostBitMask = $8000;
var
  i   : integer;
  Buf : TByteArray absolute aBuffer;
  Reg : TaaCRC16;
  B   : byte;
  bit : integer;
begin
  {initialise the register}
  Reg := 0;

  {do for all bytes in the buffer...}
  for i := 0 to pred(aBufLen) do begin
    B := Buf[i];
    {do for all bits in the current byte}
    for bit := 0 to 7 do begin
      {if the high bit of the register is 1, shift the register left
       by one, xor in the next bit from the byte, and xor the magic
       polynomial}
      if ((Reg and TopmostBitMask) <> 0) then
        Reg := (Reg shl 1) xor (B shr 7) xor aMagicPoly
      {otherwise the high bit of the register is 0, shift the register
       left by one, xor in the next bit from the byte}
      else
        Reg := (Reg shl 1) xor (B shr 7);
      B := B shl 1;
    end;
  end;

  {return the register}
  Result := Reg;
end;
{--------}
procedure AACalc16BitCRCTable(var aTable     : Taa16BitCRCTable;
                                  aMagicPoly : TaaCRC16);
const
  TopmostBitMask = $8000;
var
  i   : integer;
  Reg : TaaCRC16;
  bit : integer;
begin
  for i := 0 to 255 do begin
    Reg := i shl 8;
    for bit := 0 to 7 do begin
      if ((Reg and TopmostBitMask) <> 0) then
        Reg := (Reg shl 1) xor aMagicPoly
      else
        Reg := (Reg shl 1);
    end;
    aTable[i] := Reg;
  end;
end;
{--------}
function AAGet16BitCRCTbl(var aBuffer;
                              aBufLen    : integer;
                        const aTable     : Taa16BitCRCTable) : TaaCRC16;
var
  i   : integer;
  Buf : TByteArray absolute aBuffer;
  Reg : TaaCRC16;
begin
  {initialise the register}
  Reg := 0;
  {calculate the CRC}
  for i := 0 to pred(aBufLen) do
    Reg := aTable[byte(Reg shr 8) xor Buf[i]] xor (Reg shl 8);
  {return the register}
  Result := Reg;
end;
{====================================================================}

end.